El objetivo del presente trabajo es realizar un análisis estadístico de los datos aportados en la base de datos “Dataset_Compradores.csv”.En los primeros pasos, se realizará un análisis descriptivo y gráfico de las variables. Finalmente, se realizará un análisis estadístico.
Lo primero que se ha llegado a cabo es la importación de las librerías necesarias para el análisis de nuestra Base de Datos.
Importamos el archivo con la data a través del siguiente comando:
Compradores_datos<- read.csv("Dataset_Compradores.csv", header = TRUE,dec='.')
kable(head(Compradores_datos))
| RowNumber | CustomerId | Surname | CreditScore | Geography | Gender | Age | Tenure | Balance | NumOfProducts | HasCrCard | IsActiveMember | EstimatedSalary | Exited |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 15634602 | Hargrave | 619 | France | Female | 42 | 2 | 0.00 | 1 | 1 | 1 | 101348.88 | 1 |
| 2 | 15647311 | Hill | 608 | Spain | Female | 41 | 1 | 83807.86 | 1 | 0 | 1 | 112542.58 | 0 |
| 3 | 15619304 | Onio | 502 | France | Female | 42 | 8 | 159660.80 | 3 | 1 | 0 | 113931.57 | 1 |
| 4 | 15701354 | Boni | 699 | France | Female | 39 | 1 | 0.00 | 2 | 0 | 0 | 93826.63 | 0 |
| 5 | 15737888 | Mitchell | 850 | Spain | Female | 43 | 2 | 125510.82 | 1 | 1 | 1 | 79084.10 | 0 |
| 6 | 15574012 | Chu | 645 | Spain | Male | 44 | 8 | 113755.78 | 2 | 1 | 0 | 149756.71 | 1 |
kable(tail(Compradores_datos))
| RowNumber | CustomerId | Surname | CreditScore | Geography | Gender | Age | Tenure | Balance | NumOfProducts | HasCrCard | IsActiveMember | EstimatedSalary | Exited | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 9995 | 9995 | 15719294 | Wood | 800 | France | Female | 29 | 2 | 0.00 | 2 | 0 | 0 | 167773.55 | 0 |
| 9996 | 9996 | 15606229 | Obijiaku | 771 | France | Male | 39 | 5 | 0.00 | 2 | 1 | 0 | 96270.64 | 0 |
| 9997 | 9997 | 15569892 | Johnstone | 516 | France | Male | 35 | 10 | 57369.61 | 1 | 1 | 1 | 101699.77 | 0 |
| 9998 | 9998 | 15584532 | Liu | 709 | France | Female | 36 | 7 | 0.00 | 1 | 0 | 1 | 42085.58 | 1 |
| 9999 | 9999 | 15682355 | Sabbatini | 772 | Germany | Male | 42 | 3 | 75075.31 | 2 | 1 | 0 | 92888.52 | 1 |
| 10000 | 10000 | 15628319 | Walker | 792 | France | Female | 28 | 4 | 130142.79 | 1 | 1 | 0 | 38190.78 | 0 |
Podemos ver que existen columnas llamadas RowNumber y Exited que debemos eliminar de los datos:
| CustomerId | Surname | CreditScore | Geography | Gender | Age | Tenure | Balance | NumOfProducts | HasCrCard | IsActiveMember | EstimatedSalary |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 15634602 | Hargrave | 619 | France | Female | 42 | 2 | 0.00 | 1 | 1 | 1 | 101348.88 |
| 15647311 | Hill | 608 | Spain | Female | 41 | 1 | 83807.86 | 1 | 0 | 1 | 112542.58 |
| 15619304 | Onio | 502 | France | Female | 42 | 8 | 159660.80 | 3 | 1 | 0 | 113931.57 |
| 15701354 | Boni | 699 | France | Female | 39 | 1 | 0.00 | 2 | 0 | 0 | 93826.63 |
| 15737888 | Mitchell | 850 | Spain | Female | 43 | 2 | 125510.82 | 1 | 1 | 1 | 79084.10 |
| 15574012 | Chu | 645 | Spain | Male | 44 | 8 | 113755.78 | 2 | 1 | 0 | 149756.71 |
Comprobamos que las columnas Nrow y Exited ya no existen en nuestra data
## [1] 0
sum(is.na(Compradores_datos)) La presencia de datos ausentes dificulta la mayoría de operaciones matemáticas y de análisis.
describe(Compradores_datos)
## vars n mean sd median trimmed
## CustomerId 1 10000 15690940.57 71936.19 15690738.00 15690938.68
## Surname* 2 10000 1508.78 846.20 1543.00 1512.94
## CreditScore 3 10000 650.53 96.65 652.00 651.01
## Geography* 4 10000 1.75 0.83 1.00 1.68
## Gender* 5 10000 1.55 0.50 2.00 1.56
## Age 6 10000 38.92 10.49 37.00 37.91
## Tenure 7 10000 5.01 2.89 5.00 5.01
## Balance 8 10000 76485.89 62397.41 97198.54 74827.80
## NumOfProducts 9 10000 1.53 0.58 1.00 1.49
## HasCrCard 10 10000 0.71 0.46 1.00 0.76
## IsActiveMember 11 10000 0.52 0.50 1.00 0.52
## EstimatedSalary 12 10000 100090.24 57510.49 100193.91 100114.86
## mad min max range skew kurtosis se
## CustomerId 92562.42 15565701.00 15815690.0 249989.0 0.00 -1.20 719.36
## Surname* 1085.26 1.00 2932.0 2931.0 -0.02 -1.20 8.46
## CreditScore 99.33 350.00 850.0 500.0 -0.07 -0.43 0.97
## Geography* 0.00 1.00 3.0 2.0 0.50 -1.36 0.01
## Gender* 0.00 1.00 2.0 1.0 -0.18 -1.97 0.00
## Age 8.90 18.00 92.0 74.0 1.01 1.39 0.10
## Tenure 2.97 0.00 10.0 10.0 0.01 -1.17 0.03
## Balance 69336.44 0.00 250898.1 250898.1 -0.14 -1.49 623.97
## NumOfProducts 0.00 1.00 4.0 3.0 0.75 0.58 0.01
## HasCrCard 0.00 0.00 1.0 1.0 -0.90 -1.19 0.00
## IsActiveMember 0.00 0.00 1.0 1.0 -0.06 -2.00 0.00
## EstimatedSalary 72941.18 11.58 199992.5 199980.9 0.00 -1.18 575.10
## [1] 10000 12
## [1] "data.frame"
dim(Compradores_datos) nos entrega las dimensiones de nuestro Data Frame Filas x Columnas class(Compradores_datos) nos indica que es un DataFrame
## CustomerId Surname CreditScore Geography
## Min. :15565701 Length:10000 Min. :350.0 Length:10000
## 1st Qu.:15628528 Class :character 1st Qu.:584.0 Class :character
## Median :15690738 Mode :character Median :652.0 Mode :character
## Mean :15690941 Mean :650.5
## 3rd Qu.:15753234 3rd Qu.:718.0
## Max. :15815690 Max. :850.0
## Gender Age Tenure Balance
## Length:10000 Min. :18.00 Min. : 0.000 Min. : 0
## Class :character 1st Qu.:32.00 1st Qu.: 3.000 1st Qu.: 0
## Mode :character Median :37.00 Median : 5.000 Median : 97199
## Mean :38.92 Mean : 5.013 Mean : 76486
## 3rd Qu.:44.00 3rd Qu.: 7.000 3rd Qu.:127644
## Max. :92.00 Max. :10.000 Max. :250898
## NumOfProducts HasCrCard IsActiveMember EstimatedSalary
## Min. :1.00 Min. :0.0000 Min. :0.0000 Min. : 11.58
## 1st Qu.:1.00 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.: 51002.11
## Median :1.00 Median :1.0000 Median :1.0000 Median :100193.91
## Mean :1.53 Mean :0.7055 Mean :0.5151 Mean :100090.24
## 3rd Qu.:2.00 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:149388.25
## Max. :4.00 Max. :1.0000 Max. :1.0000 Max. :199992.48
Se emplea la función Summary que genera un resumen del contenido, para variables númericas aportando estadísticos básicos y para variables cualitativas entrega un conteo de apariciones por posible valor.
paises<-ggplot(Compradores_datos)+
geom_bar(mapping = aes(x=Geography,color=Geography,fill=Geography))+
geom_text(stat='count', aes(x = Geography, label = ..count..), vjust = -1)+
ylim(0, 7000)+
ggtitle('Cantidad de Observaciones Paises')+
theme_classic();paises
##
## France Germany Spain
## 5014 2509 2477
Con la Tabla y Gráfico podemos ver como se distribuyen la cantidad de datos por países.
##
## Female Male
## 4543 5457
Genero_bar<-ggplot(Compradores_datos)+
geom_bar(mapping = aes(x=Gender,color=Gender,fill=Gender))+
geom_text(stat='count', aes(x = Gender, label = ..count..), vjust = -1)+
ylim(0, 7000)+
ggtitle('Cantidad de Observaciones por Género')+
theme_classic();Genero_bar
Cantidad de Hombres Y Mujeres por País
Genero_Pais<-ggplot(Compradores_datos)+
geom_bar(mapping = aes(x=Gender,color=Gender,fill=Gender))+
geom_text(stat='count', aes(x = Gender, label = ..count..), vjust = -1)+
ylim(0, 3500)+
ggtitle('Cantidad de Observaciones por Género')+
facet_grid(.~Geography);Genero_Pais
#### Variables GÉNERO_SALARIO_PAÍS
Genero_salario<-ggplot(Compradores_datos,aes(x=Gender,y=EstimatedSalary))+
geom_boxplot(aes(fill=Gender),outlier.shape ='x')+
xlab('Género')+ ylab('Salario Estimado') +
ggtitle('Distribución de Salario por Género-País')+
facet_grid(.~Geography)+
theme_bw();Genero_salario
salario_Edad<-ggplot(Compradores_datos,aes(x=Age,y=EstimatedSalary))+
geom_point(mapping = aes(x=Age,y=EstimatedSalary,color=Geography,fill=Geography))+
xlab('Edad')+ ylab('Salario Estimado') +
ggtitle('Distribución de Salario por País-Edad');salario_Edad
salario_Edad<-salario_Edad+
geom_smooth(method='lm',color='black')+
facet_grid(.~Geography);salario_Edad
## `geom_smooth()` using formula 'y ~ x'
Podemos apreciar que no existe una correlación lineal entre las variables, ya que no hay una tendencia clara en la dispersión de sus datos Nota: Si utilizamos un nivel de confianza del 95% y obtenemos que p < .05, rechazamos la H0 y decimos que existe una correlación significativa (H1)
CreditScore_Balance<-ggplot(Compradores_datos,aes(x=CreditScore,y=Balance))+
geom_point(mapping = aes(x=CreditScore,y=Balance,color=Geography,fill=Geography))+
xlab('CrediScore')+ ylab('Balance') +
ggtitle('Distribución de Credit Score y Balance');CreditScore_Balance
CreditScore_Balance<-CreditScore_Balance+
geom_smooth(method='lm',color='black')+
facet_grid(.~Geography);CreditScore_Balance
## `geom_smooth()` using formula 'y ~ x'
No se aprecia una correlación por lo que se adeuda (Balance) y rating de crédito (CreditScore)
Salario_genero_normal <-ggplot(Compradores_datos)
Salario_genero_normal+geom_histogram(aes(x=EstimatedSalary,y=..density.., fill=Gender), bins = 50, color = 'black') +
xlab('Salario Anual Estimado')+ ylab('Density') +
stat_function(fun = dnorm,args = list(mean = mean(Compradores_datos$EstimatedSalary),
sd = sd(Compradores_datos$EstimatedSalary))) +
theme(legend.position = "bottom", legend.direction = "horizontal")+
ggtitle('Distribucion de Salario por Género')+
facet_grid(Geography~Gender)
Podemos apreciar que la Curtósis es tipo Platicúrtica
Relación de deuda vencida por Género
Ternure0<-Compradores_datos %>%
filter(Tenure == '0') %>%
filter(Balance > 0)
Deudavencida <- ggplot(Ternure0, aes(x=Gender, fill=Gender))+
geom_bar()+
ylim(0,70)+
geom_text(stat='count', aes(x = Gender, label = ..count..), vjust = -1)+
facet_grid(~Geography);Deudavencida
Observamos que hay tendencia que las mujeres tienen mayor deuda vencida.
## [1] FALSE
##
## Bad Good Excellent
## 1621 6781 1598
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 350.0 584.0 652.0 650.5 718.0 850.0
Para esta gráfica utilizamos un supuesto para segmentar a los clientes en base a su credit_score en donde:
-CreditScore <=550 ->‘Bad’ -CreditScore>=551 & CreditScore<=750 ->‘Good’ -CreditScore>=751->‘Excellent’
H0: la media de los salarios en Alemania,Francia y España son iguales
H1: la media de los salarios en Alemania,Francia y España son distintas
Para realizar el análisis hemos escogido el test de ANOVA, ya que existe una variable numérica (Estimated_ Salary) y tres categóricas (Alemania,Francia y España)
plotmeans(Compradores_datos$EstimatedSalary~Compradores_datos$Geography,
mean.labels=T,main = 'Salario Promedio por País',ylab='Salario Estimado',xlab='País')
Como primera impresión podemos ver que existe una similaridad entre medias.
HISTOGRAMA Y CURVA NORMAL
## Geography grp.mean
## 1 France 99899.18
## 2 Germany 101113.44
## 3 Spain 99440.57
Podemos observar que la distribución del salario estimado entre país es mas o menos normal, nos apoyaremos de otros métodos para concluir sobre la distribución normal
## Warning in rbind(normalize_Spain, normalize_Germany, normalize_France): number
## of columns of result is not a multiple of vector length (arg 1)
QQ-TEST
qqnorm(Compradores_datos$EstimatedSalary, main="Q-Q plot de los salarios");
qqline(Compradores_datos$EstimatedSalary,distribution = qnorm, col = "steelblue",lwd = 4)
Este test nos representa la distribución que seguirá nuestra distribución si fuera normal.
Se puede observar que existen diferencias entre la curva teórica y la de nuestros datos.
Kolmogorov-Smirnov Tests
ks.test(Compradores_datos$EstimatedSalary,'pnorm')
## Warning in ks.test(Compradores_datos$EstimatedSalary, "pnorm"): ties should not
## be present for the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: Compradores_datos$EstimatedSalary
## D = 1, p-value < 2.2e-16
## alternative hypothesis: two-sided
Según el resultado de este test, la distribución de la variable salario no es normal ya que p value<0.05
Lillie test
#install.packages('nortest')
lillie.test(Compradores_datos$EstimatedSalary)
##
## Lilliefors (Kolmogorov-Smirnov) normality test
##
## data: Compradores_datos$EstimatedSalary
## D = 0.055095, p-value < 2.2e-16
De nuevo esta hipótesis nos dice que la distribución de la muestra no es normal p-value<0.05
bartlett.test(Compradores_datos$EstimatedSalary,Compradores_datos$Geography )
##
## Bartlett test of homogeneity of variances
##
## data: Compradores_datos$EstimatedSalary and Compradores_datos$Geography
## Bartlett's K-squared = 1.1953, df = 2, p-value = 0.5501
Según este test, las varianzas son iguales, el p-value > 0.05
También se puede revisar este supuesto mediante un by y observando los resultados que se obtienen
by(Compradores_datos$EstimatedSalary,Compradores_datos$Geography,var)
## Compradores_datos$Geography: France
## [1] 3287450038
## ------------------------------------------------------------
## Compradores_datos$Geography: Germany
## [1] 3394578509
## ------------------------------------------------------------
## Compradores_datos$Geography: Spain
## [1] 3260830052
Queda demostrado que las varianzas son prácticamente iguales.
anova(lm(Compradores_datos$EstimatedSalary~Compradores_datos$Geography))
## Analysis of Variance Table
##
## Response: Compradores_datos$EstimatedSalary
## Df Sum Sq Mean Sq F value Pr(>F)
## Compradores_datos$Geography 2 3.8552e+09 1927617402 0.5828 0.5584
## Residuals 9997 3.3067e+13 3307732835
La primera línea nos habla de la variación entre grupo, se aprueba ya que el P value es > a 0.05
x <- aov(EstimatedSalary ~ Geography, data = Compradores_datos)
summary(x)
## Df Sum Sq Mean Sq F value Pr(>F)
## Geography 2 3.855e+09 1.928e+09 0.583 0.558
## Residuals 9997 3.307e+13 3.308e+09
Misma comprobación para ver que las varianzas son muy similares
pairwise.t.test(Compradores_datos$EstimatedSalary, Compradores_datos$Geography, p.adj="bonferroni")
##
## Pairwise comparisons using t tests with pooled SD
##
## data: Compradores_datos$EstimatedSalary and Compradores_datos$Geography
##
## France Germany
## Germany 1.00 -
## Spain 1.00 0.91
##
## P value adjustment method: bonferroni
Finalmente con esta función podemos observar que las medias entre las variables son casi iguales.